home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Pascal / source / Directory Massager / UglyMassage.Pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  1.9 KB  |  77 lines  |  [TEXT/EDIT]
  1. program GenieDir(Input,Output);{November 30,1986}
  2.  
  3.  var
  4.   source : text;
  5.   finish : text;
  6.   index : integer;
  7.   firstline, secondline, it, ot : string;
  8.   yet : boolean;
  9.   item : array[0..7] of string;
  10.  procedure find;
  11.  var hmm : string;
  12.  begin{procedure find}
  13.   repeat
  14.    yet := false;
  15.    readln(source, firstline);
  16.    if length(firstline) < 4 then
  17.     firstline := 'xxxx';
  18.    hmm := copy(firstline,4,1);
  19. if ((hmm >'/')and(hmm<':')) then
  20.     yet := true;
  21.     writeln(hmm,' ',yet);
  22.     if eof(source) then yet := true;
  23.   until yet;
  24.   if eof(source) then
  25.    secondline := '      Desc: lost the description'
  26.   else
  27.    readln(source, secondline);
  28.  end;{of procedure find}
  29.  procedure peel;
  30.   var
  31.    index : integer;
  32.  begin{procedure peel}
  33.  
  34.   item[0] := copy(firstline, 1, 6);
  35.   item[1] := copy(firstline, 7, 25);
  36.   item[2] := copy(firstline, 32, 15);
  37.   item[3] := copy(firstline, 47, 7);
  38.   item[4] := copy(firstline, 54, 8);
  39.   item[5] := copy(firstline, 62, 7);
  40.   item[6] := copy(firstline, 69, 3);
  41.   item[7] := copy(secondline, 13, 40);
  42.   for index := 0 to 7 do
  43.    begin{cut spaces}
  44.     while pos(' ', item[index]) = 1 do
  45.      delete(item[index], 1, 1);
  46.     while (copy(item[index], length(item[index]), 1) = ' ') do
  47.      delete(item[index], length(item[index]), 1);
  48.    end;{of cut spaces}
  49.   for index := 0 to 6 do{add tab delimiters}
  50.    item[index] := concat(item[index], chr(9));
  51.  end;{of procedure peel}
  52.  
  53. begin {main program}
  54. Writeln('What textfile to massage?');
  55. Readln(it);
  56. if it <> '' then
  57.   begin{anything to do}
  58.    Reset(source, it);
  59.    Writeln('What destination textfile?');
  60.    Readln(ot);
  61.    rewrite(finish, ot);
  62.    while not eof(source) do
  63.     begin
  64.      find;
  65.      peel;
  66.      for index := 0 to 6 do
  67.      begin
  68.      write(finish,item[index]);
  69.       write(item[index]);
  70.      end;
  71.      writeln(item[7]);
  72.      writeln(finish, item[7]);
  73.     end;
  74.    close(source);
  75.    close(finish);
  76.   end;{of anything to do}
  77. end.